home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / ms_dos / pword / pword.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-08  |  3.6 KB  |  127 lines
  1. Program PWord;
  2. uses dos,crt;
  3.  
  4. const
  5.    {カラーテーブル設定}
  6.    kuro=0;Ao=1;Midori=2;Mizuiro=3;Aka=4;Kiiro=6;Murasaki=5;Shiro=7;
  7. var
  8.    jisyo,jisyo_out:text;{印刷するファイル名}
  9.    Eng,
  10.    Jap,OutLine,
  11.    FileLine:string;
  12.    select:char;
  13.  
  14. {==========此処からは関数, 手続きを書く=================================}
  15. function B_pos(locate:integer; key,s:string):integer;
  16. var             {s の locate 文字目から key を探してその番号を帰す}
  17.     Dammy:string[255];
  18. begin
  19.     Dammy:=copy(s,locate,length(s)-locate+1);
  20.     If Pos(key,Dammy)=0 then B_Pos:=0
  21.         else B_Pos:=Pos(key,Dammy)+locate-1;
  22. end;
  23.  
  24. {==メモリーが充分かどうかをチェックするルーチン==ここは既に完成==}
  25. {$f+}
  26. function  HeapFunc(Size: word): integer;
  27. {$f-}
  28. begin
  29.    Writeln(^G+'メモリーが足りません');
  30.    HeapFunc := 1;
  31. end;  { HeapErrorFunc }
  32.  
  33. {=========タイトル表示ルーチン===ここは既に完成==========================}
  34. procedure Title;     {コピーライト表示}
  35. begin
  36.     clrscr;
  37.         TextColor(Shiro);
  38.         Write('      －－－－ For All FM-Series');
  39.         Writeln(' 英文翻訳支援プログラムシリーズ －－－－');
  40.     Write('                 －－－ ');
  41.     TextColor(mizuiro);
  42.     Write('ＰＷＯＲＤ．ＥＸＥ　Ver.1.02α');
  43.     TextColor(Shiro);
  44.     Writeln(' －－－');
  45.     WriteLn('                       Programed by H.Nakayasu (c) 1992');
  46.     TextColor(Shiro);
  47. end;
  48.  
  49. procedure line;
  50. var i:integer;
  51. begin
  52.    textcolor(midori);
  53.    for i:=1 to 80 do
  54.      write('-');
  55.    textcolor(shiro);
  56. end;
  57.  
  58. {===編集ファイルの確認(存在を含めて)====完成================================}
  59. procedure CheckFileExistAndOpenFile;
  60. procedure CheckFileExistAndOpenFileSub;
  61. begin
  62.         Textcolor(aka);
  63.         writeln('＜使い方＞');
  64.         Textcolor(shiro);
  65.         writeln('PWord [ファイル名] ([ファイル名])');
  66.         halt(1);
  67. end;
  68. begin
  69.    IF paramcount=0 then CheckFileExistAndOpenFileSub;
  70.    Assign(Jisyo,paramstr(1));
  71.    {$i-}  Reset(Jisyo);  {$i+}
  72.    if IOResult <> 0 then CheckFileExistAndOpenFileSub;
  73. end;
  74.  
  75. begin{メインルーチン}
  76. {===初期の表示=====完成=====================================}
  77.    HeapError := @HeapFunc;
  78.    CheckFileExistAndOpenFile;
  79.    title;
  80.    line;
  81.  
  82. {===一行を辞書ファイルより切り取り、単語と訳を印刷する==完成===============}
  83. IF not(paramstr(2)='') then
  84.  begin
  85.      Assign(Jisyo_out,paramstr(2));
  86.      {$i-}  Append(Jisyo_out);  {$i+}
  87.      if IOResult=0 then
  88.         begin
  89.            writeln(paramstr(2),'が存在します。上書きしても宜しいですか？');
  90.            writeln('上書きするとファイルの中身は消去されます。［Ｙ／Ｎ］');
  91.            repeat
  92.              select:=readkey;
  93.            until select in ['Y','y','N','n'];
  94.           if (select='y')or(select='Y') then rewrite(Jisyo_out)
  95.                                         else
  96.                                            begin
  97.                                              close(JIsyo);
  98.                                              close(JIsyo_out);
  99.                                              halt(1);
  100.                                            end;
  101.         end{end of if}
  102.      else
  103.         begin
  104.            rewrite(Jisyo_out)
  105.         end;
  106.   end;{end of IF}
  107.  
  108. while not eof(Jisyo) do
  109. begin
  110.  readln(JIsyo,FileLine);
  111.     Eng:=copy(FileLine,1,B_pos(1,'/',Fileline)-1);
  112.     Jap:=copy(FileLine,B_pos(1,'/',Fileline)+1,Length(FileLine));
  113.     Outline:=eng;
  114.     writeln(eng,' ':20-length(eng),jap);
  115.     IF paramstr(2)<>'' then
  116.            writeln(Jisyo_out,eng,' ':20-length(eng),jap);
  117. end;
  118.  
  119.    close(Jisyo);
  120.    IF paramstr(2)<>'' then Begin
  121.                               flush(Jisyo_out);
  122.                               close(Jisyo_out);
  123.                            end;
  124.    textcolor(shiro);
  125.    halt(0);
  126. end.
  127.